home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 014 / pibcat.arc / PIBCATL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-20  |  13.5 KB  |  336 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Display_Lbr_Contents --- Display contents of library (.LBR) file   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Lbr_Contents( LbrFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Lbr_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a library file (.LBR file)        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Lbr_Contents( LbrFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          LbrFileName --- name of library file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date  --- convert DOS packed date to string     *)
  25. (*          Dir_Convert_Time  --- convert DOS packed time to string     *)
  26. (*          Display_File_Info --- display information about a file      *)
  27. (*          Open_File         --- open a file                           *)
  28. (*          Close_File        --- close a file                          *)
  29. (*                                                                      *)
  30. (*----------------------------------------------------------------------*)
  31.  
  32. (*----------------------------------------------------------------------*)
  33. (*              Map of Library file (.LBR) entry header                 *)
  34. (*----------------------------------------------------------------------*)
  35.  
  36. TYPE
  37.    Lbr_Entry_Type = RECORD
  38.                        Flag  : BYTE                   (* LBR - Entry flag *);
  39.                        Name  : ARRAY[1 .. 8] OF CHAR  (* File name *);
  40.                        Ext   : ARRAY[1 .. 3] OF CHAR  (* Extension *);
  41.                        Offset: INTEGER                (* Offset within Library *);
  42.                        N_sec : INTEGER                (* Number of 128-byte sectors *);
  43.                        CRC   : INTEGER                (* CRC (optional) *);
  44.                        Date  : INTEGER                (* # days since 1/1/1978 *);
  45.                        UDate : INTEGER                (* Date of last update *);
  46.                        Time  : INTEGER                (* Packed time *);
  47.                        UTime : INTEGER                (* Time of last update *);
  48.                        Pads  : ARRAY[1 .. 6] OF CHAR  (* Currently unused *);
  49.                     END;
  50.  
  51. CONST
  52.    Lbr_Header_Length = 32          (* Length of library file header entry *);
  53.  
  54. VAR
  55.    LbrFile       : FILE            (* Library file *);
  56.    Lbr_Entry     : Lbr_Entry_Type  (* Header describing one file in library *);
  57.    Lbr_Pos       : REAL            (* Current byte position in library *);
  58.    Lbr_Dir_Size  : INTEGER         (* # of entries in library directory *);
  59.    Bytes_Read    : INTEGER         (* # bytes read at current file position *);
  60.    Ierr          : INTEGER         (* Error flag *);
  61.  
  62. (*----------------------------------------------------------------------*)
  63. (*      Get_Next_Lbr_Entry --- Get next header entry in library         *)
  64. (*----------------------------------------------------------------------*)
  65.  
  66. FUNCTION Get_Next_Lbr_Entry( VAR LbrEntry : Lbr_Entry_Type;
  67.                              VAR Error    : INTEGER ) : BOOLEAN;
  68.  
  69. VAR
  70.    Month : INTEGER;
  71.    Year  : INTEGER;
  72.    Done  : BOOLEAN;
  73.    T     : INTEGER;
  74.                                    (* # of days in each month *)
  75. (* STRUCTURED *) CONST
  76.    NDays : ARRAY[1..12] OF INTEGER = ( 31, 28, 31, 30, 31, 30,
  77.                                        31, 31, 30, 31, 30, 31  );
  78.  
  79. BEGIN (* Get_Next_Lbr_Entry *)
  80.                                    (* Assume no error *)
  81.    Error := 0;
  82.                                    (* Loop over directory entries *)
  83.    REPEAT
  84.                                    (* Decrement directory entry count. *)
  85.                                    (* If = 0, reached end of directory *)
  86.                                    (* entries.                         *)
  87.  
  88.       Lbr_Dir_Size := PRED( Lbr_Dir_Size );
  89.       IF ( Lbr_Dir_Size < 0 ) THEN
  90.          Error := End_Of_File;
  91.                                    (* If not end of entries ... *)
  92.       IF ( Error = 0 ) THEN
  93.          BEGIN
  94.                                    (* If not first time, move to next   *)
  95.                                    (* directory entry position in file. *)
  96.  
  97.             IF ( Lbr_Pos <> 0.0 ) THEN
  98.                LongSeek( LbrFile, Lbr_Pos );
  99.  
  100.                                    (* Read directory entry *)
  101.  
  102.             BlockRead( LbrFile, Lbr_Entry, SizeOf( Lbr_Entry ), Bytes_Read );
  103.             Error := 0;
  104.                                    (* If wrong length, .LBR format must *)
  105.                                    (* be incorrect.                     *)
  106.  
  107.             IF ( Bytes_Read < Lbr_Header_Length ) THEN
  108.                Error := Format_Error
  109.             ELSE
  110.                                    (* If length OK, assume entry OK. *)
  111.                WITH Lbr_Entry DO
  112.                   BEGIN
  113.                                    (* Point to next .LBR entry in file *)
  114.  
  115.                      Lbr_Pos := Lbr_Pos + Lbr_Header_Length;
  116.  
  117.                                    (* Pick up time/date of creation this *)
  118.                                    (* entry if specified.  If the update *)
  119.                                    (* time/date is different, then we    *)
  120.                                    (* will report that instead.          *)
  121.  
  122.                      IF ( Time = 0 ) THEN
  123.                         BEGIN
  124.                            Time := UTime;
  125.                            Date := UDate;
  126.                         END
  127.                      ELSE
  128.                         IF ( ( Time <> UTime ) OR ( Date <> UDate ) ) THEN
  129.                            BEGIN
  130.                               Time := UTime;
  131.                               Date := UDate;
  132.                            END;
  133.                                    (* Convert date from library format of *)
  134.                                    (* # days since 1/1/1978 to DOS format *)
  135.                      Month := 1;
  136.                      Year  := 78;
  137.                                    (* This is done using brute force. *)
  138.                      REPEAT
  139.                                    (* Account for leap years *)
  140.  
  141.                         T    := 365 + ORD( Year MOD 4 = 0 );
  142.  
  143.                                    (* See if we have less than 1 year left *)
  144.  
  145.                         Done := ( Date < T );
  146.  
  147.                         IF ( NOT Done ) THEN
  148.                            BEGIN
  149.                               Year := SUCC( Year );
  150.                               Date := Date - T;
  151.                            END;
  152.  
  153.                      UNTIL Done;
  154.                                    (* Now get months and days within year *)
  155.                      REPEAT
  156.  
  157.                         T    := Ndays[Month] +
  158.                                 ORD( ( Month = 2 ) AND ( Year MOD 4 = 0 ) );
  159.  
  160.                         Done := ( Date < T );
  161.  
  162.                         IF ( NOT Done ) THEN
  163.                            BEGIN
  164.                               Month := SUCC( Month );
  165.                               Date  := Date - T;
  166.                            END;
  167.  
  168.                      UNTIL Done;
  169.                                    (* If > 1980, convert to DOS date *)
  170.                                    (* else leave unconverted.        *)
  171.  
  172.                      IF ( Year >= 80 ) THEN
  173.                         Date := ( Year - 80 ) SHL 9 + Month SHL 5 + Date
  174.                      ELSE
  175.                         Date := 0;
  176.  
  177.                   END (* With *);
  178.  
  179.          END   (* Error = 0 *);
  180.  
  181.    UNTIL ( ( Error <> 0 ) OR ( Lbr_Entry.Flag = 0 ) );
  182.  
  183.                                    (* Report success/failure to caller *)
  184.  
  185.    Get_Next_Lbr_Entry := ( Error = 0 );
  186.  
  187. END   (* Get_Next_Lbr_Entry *);
  188.  
  189. (*----------------------------------------------------------------------*)
  190. (*      Display_Lbr_Entry --- Display library header entry              *)
  191. (*----------------------------------------------------------------------*)
  192.  
  193. PROCEDURE Display_Lbr_Entry( Lbr_Entry : Lbr_Entry_Type );
  194.  
  195. VAR
  196.    SDate      : STRING[10];
  197.    STime      : STRING[12];
  198.    I          : INTEGER;
  199.    FName      : AnyStr;
  200.    RLength    : REAL;
  201.    RSize      : REAL;
  202.  
  203. BEGIN (* Display_Lbr_Entry *)
  204.  
  205.    WITH Lbr_Entry DO
  206.       BEGIN
  207.                                    (* Pick up file name *)
  208.  
  209.          FName := TRIM( Name );
  210.  
  211.          IF ( Ext <> '   ' ) THEN
  212.             FName   := FName + '.' + Ext;
  213.  
  214.                                    (* Write out file name *)
  215.  
  216.          WRITE( Output_File , Left_Margin_String , '      ' , FName );
  217.  
  218.          FOR I := LENGTH( FName ) TO 13 DO
  219.             WRITE( Output_File , ' ' );
  220.  
  221.                                    (* Convert length in sectors to *)
  222.                                    (* length in bytes.             *)
  223.  
  224.          RLength := N_Sec * 128.0;
  225.          WRITE( Output_File , RLength:8:0, '  ' );
  226.  
  227.                                    (* If time/date specified, output *)
  228.                                    (* them.                          *)
  229.          IF ( Date > 0 ) THEN
  230.             BEGIN
  231.                Dir_Convert_Date( Date , SDate );
  232.                Dir_Convert_Time( Time , STime );
  233.             END
  234.          ELSE
  235.             BEGIN
  236.                SDate := '        ';
  237.                STime := '        ';
  238.             END;
  239.  
  240.          WRITE( Output_File , SDate, '  ' );
  241.          WRITE( Output_File , STime );
  242.          WRITELN( Output_File );
  243.                                    (* Count lines left on page *)
  244.          IF Do_Printer_Format THEN
  245.             BEGIN
  246.                Lines_Left := Lines_Left - 1;
  247.                IF ( Lines_Left < 1 ) THEN
  248.                   Display_Page_Titles;
  249.             END;
  250.  
  251.       END;
  252.  
  253. END (* Display_Lbr_Entry *);
  254.  
  255. (*----------------------------------------------------------------------*)
  256.  
  257. BEGIN (* Display_Lbr_Contents *)
  258.  
  259.                                    (* Set library left margin spacing *)
  260.  
  261.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , ArcLbr_Indent );
  262.  
  263.                                    (* Set file title *)
  264.  
  265.    File_Title := Left_Margin_String + ' Library file: ' + LbrFileName;
  266.  
  267.                                    (* Display library file's name *)
  268.    IF Do_Printer_Format THEN
  269.       IF Lines_Left < 3 THEN
  270.          Display_Page_Titles;
  271.  
  272.    WRITELN( Output_File ) ;
  273.    WRITE  ( Output_File , File_Title );
  274.  
  275.    Lines_Left := Lines_Left - 2;
  276.  
  277.                                    (* Open library file *)
  278.  
  279.    Open_File( LbrFileName , LbrFile, Lbr_Pos, Ierr );
  280.  
  281.                                    (* Set # directory entries = 1 so   *)
  282.                                    (* we can process actual directory. *)
  283.    Lbr_Dir_Size := 1;
  284.                                    (* Issue error message if library file *)
  285.                                    (* can't be opened.                    *)
  286.    IF ( Ierr <> 0 ) THEN
  287.       BEGIN
  288.          WRITELN( Output_File , DUPL( ' ' , 13 - LENGTH( LbrFileName ) ),
  289.                                 '     Can''t open library file ',LbrFileName );
  290.          IF Do_Printer_Format THEN
  291.             BEGIN
  292.                Lines_Left := Lines_Left - 1;
  293.                IF ( Lines_Left < 1 ) THEN
  294.                   Display_Page_Titles;
  295.             END;
  296.          EXIT;
  297.       END
  298.    ELSE
  299.       BEGIN
  300.          WRITELN( Output_File );
  301.          WRITELN( Output_File );
  302.                                    (* Count lines left on page *)
  303.          IF Do_Printer_Format THEN
  304.             BEGIN
  305.                Lines_Left := Lines_Left - 1;
  306.                IF ( Lines_Left < 1 ) THEN
  307.                   Display_Page_Titles;
  308.             END;
  309.       END;
  310.                                    (* Pick up actual number of entries *)
  311.                                    (* in library.                      *)
  312.  
  313.    IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
  314.       WITH Lbr_Entry DO
  315.          IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_sec <> 0 ) ) THEN
  316.             Lbr_Dir_Size := N_Sec * 4 - 1
  317.          ELSE
  318.             Ierr := Format_Error;
  319.  
  320.                                    (* Loop over library entries and print *)
  321.                                    (* information about each entry.       *)
  322.    IF( Ierr = 0 ) THEN
  323.       WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
  324.          Display_Lbr_Entry( Lbr_Entry );
  325.  
  326.                                    (* Close library file *)
  327.    Close_File( LbrFile );
  328.                                    (* Restore previous left margin spacing *)
  329.  
  330.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  331.  
  332.                                    (* No file title *)
  333.    File_Title := '';
  334.  
  335. END   (* Display_Lbr_Contents *);
  336.